home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir42
/
fprodups.zip
/
ELIMDUPE.PRG
Wrap
Text File
|
1993-08-22
|
5KB
|
181 lines
There have been a number of requests for a routine to eliminate
duplicate records from .DBF tables. In response, I have written
a general purpose utility that can be added (as is) to a FoxPro
application to meet this requirement and am posting it here for
release for public consumption, with limited license.
The procedure as written will perform the following steps:
1) Check for existence of the DUPEFLAG field, and if it
is not found will modify the table structure, merge
the existing data and reindex all fields ;
2) Process all fields, excluding the DUPEFLAG field and
field types Memo, General, and Picture for determining
duplicates ;
3) Make a final pass to correctly mark the first entry of
a duplicated record and delete subsequent records that
are flagged as duplicates.
With minor modifications, this procedure can be adapted to cover
other xBase dialects, or be applied to specific cases where a
selected subset of the data fields are to be considered, and/or
the increased performance of a less intensive search is desirable.
To take advantage of this procedure in applications that you are
developing, add a menu entry for "\<Delete duplicates" or modify
the "\<Construct indexes" in the utilities submenu of the FOXAPP
project and enter the following code as a procedure.
* <start of code snippet>
DO elimdupe WITH ALIAS()
SET ORDER TO 1
GOTO TOP
_CUROBJ = 1
WAIT WINDOW "Duplicate deletion completed" NOWAIT
SHOW GETS
* <end of code snippet>
In addition, the following code for the ELIMDUPE procedure should
be added to the APPPROC.PRG procedure file. Rebuild the project
and generate the FOXAPP application for the changes to take effect.
*!******************************************************************
*!
*! Procedure: ELIMDUPE
*! Copyright 1993 by Michael D. Long
*!
*! You are granted the right to use this code, either "as is"
*! or modified to your particular needs, in applications that
*! you develop, but only as part of a completed work. Rights
*! to publication or other usage where the code is presented
*! as an individual work are reserved by the author, and in
*! addition neither the copyright notice nor any portion of
*! the limitations of the license shall be removed or abridged.
*!
*!******************************************************************
PROCEDURE elimdupe
* Eliminate all duplicate records in current table (mark as deleted)
PARAMETERS filname
PRIVATE comp_stat, safe_stat, in_area, fstem, i, dfflag, fsnew, fdnew
comp_stat = SET("COMPATIBLE")
safe_stat = SET("SAFETY")
SET COMPATIBLE TO FOXPLUS
SET SAFETY OFF
m.in_area = SELECT() && currently selected area
m.fstem = juststem(m.filname)
IF USED(m.fstem)
SELECT (m.fstem)
ELSE
SELECT 0
USE (m.filname)
ENDIF
dfflag = .F.
FOR i = 1 TO FCOUNT()
IF FIELD(i) = "DUPEFLAG"
dfflag = .T.
ENDIF
ENDFOR
IF !dfflag
fsnew = SYS(3)
fdnew = SYS(3)
COPY STRUCTURE EXTENDED TO (m.fsnew)
SELECT 0
USE (m.fsnew)
APPEND BLANK
REPLACE field_name WITH 'DUPEFLAG', field_type WITH 'L', ;
field_len WITH 1, field_dec WITH 0
USE
SELECT (m.fstem)
SET ORDER TO (FIELD(1))
COPY TO (m.fdnew)
USE
CREATE (m.filname) FROM (m.fsnew)
APPEND FROM (m.fdnew)
FOR i = 1 TO FCOUNT()
fldname = FIELD(i)
IF !INLIST(TYPE(m.fldname),"M","G","P")
WAIT WINDOW "Indexing on "+m.fldname NOWAIT
INDEX ON &fldname TAG (m.fldname)
ENDIF
ENDFOR
ERASE (m.fsnew)+".DBF"
ERASE (m.fdnew)+".DBF"
IF FILE((m.fdnew)+".FPT")
ERASE (m.fdnew)+".FPT"
ENDIF
ENDIF
REPLACE dupeflag WITH .T. FOR NOT DELETED()
SET FILTER TO dupeflag
ffldoccr = 0
FOR i = 1 TO FCOUNT()
fldname = FIELD(i)
IF !INLIST(TYPE(m.fldname),"M","G","P")
IF ffldoccr = 0
ffldoccr = i && establish number of first valid field type
ENDIF
IF !(m.fldname = "DUPEFLAG ")
WAIT WINDOW "Eliminating duplicates on "+m.fldname NOWAIT
SET ORDER TO (m.fldname)
GO TOP
crc = &fldname
DO WHILE NOT EOF()
SKIP
IF crc <> &fldname
crc = &fldname
IF NOT EOF()
SKIP
IF crc <> &fldname
SKIP -1
REPLACE dupeflag WITH .F.
ELSE
SKIP -1
ENDIF
ENDIF
ENDIF
ENDDO
ENDIF
ENDIF
ENDFOR
fldname = FIELD(ffldoccr)
WAIT WINDOW "Tagging duplicates as deleted" NOWAIT
SET ORDER TO (m.fldname)
GO TOP
DO WHILE NOT EOF()
crc = &fldname
REPLACE dupeflag WITH .F.
SKIP
DO WHILE crc == &fldname AND NOT EOF()
DELETE NEXT 1
SKIP
ENDDO
ENDDO
SET FILTER TO
IF m.in_area <> SELECT()
USE
ENDIF
SELECT (m.in_area)
IF m.comp_stat = "ON" OR m.comp_stat = "DB4"
SET COMPATIBLE TO DB4
ENDIF
IF m.safe_stat = "ON"
SET SAFETY ON
ENDIF
RETURN